prior <- c(0.1, 0.2, 0.3)
target <- 0.2
obswin <- 56
Consider a trial with:
The simplest case would involve just a single patient. There are two possible outcomes:
If a toxicity occurs, the time it happens is irrelevent as the weighting is automatically set at 1,
level <- 1
tox <- 1
followup <- 56
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, scheme = 'linear', followup = followup)
mod
## Today: Tue Aug 18 21:08:19 2020
## DATA SUMMARY (TITE-CRM)
## PID Level Toxicity f/u Weight Included
## 1 1 1 56 1 1
##
## Toxicity probability update (with 90 percent probability interval):
## Level Prior n total.wts total.tox Ptox LoLmt UpLmt
## 1 0.1 1 1 1 0.507 0.078 0.835
## 2 0.2 0 0 0 0.622 0.168 0.882
## 3 0.3 0 0 0 0.701 0.263 0.91
## Next recommended dose level: 1
## Recommendation is based on a target toxicity probability of 0.2
##
## Estimation details:
## Empiric dose-toxicity model: p = dose^{exp(beta)}
## dose = 0.1 0.2 0.3
## Normal prior on beta with mean 0 and variance 1.34
## Posterior mean of beta: -1.222
## Posterior variance of beta: 0.65
The reccommended dose is dose level 1.
If no toxicity is observed the next dose allocated would depend on the follow up of the patient. Here there would be 56 different possibilities. The patient could be followed up for either \(1, 2, 3, ..., 56\) days.
tox <- 0
followup <- 1:obswin
results <- data.frame('Observed' = followup, 'Rec' = rep(0,obswin))
for (i in 1:obswin) {
followup <- i
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, scheme = 'linear', followup = followup)
results$Rec[i] <- mod$mtd
}
We can determine the next dose by looping through all possible values of follow up. The results can be summarised using the min and max follow up days for each dose.
results <- results %>% group_by('Next Dose' = Rec) %>%
summarise('Follow up data' = paste(min(Observed), max(Observed),
sep ='-'))
kable(results, align = 'cc') %>%
kable_styling(full_width = F, position = 'left')
| Next Dose | Follow up data |
|---|---|
| 2 | 1-30 |
| 3 | 31-56 |
This can be interpreted as the next dose will be 2 if the previous patien has no toxicity and has been observed between 1 and 30 days. Likewise, the next dose level would be 3 if no toxicities were observed between days 31 and 56.
kable(results %>%
pivot_wider(names_from = `Next Dose`, values_from = `Follow up data` ) %>% mutate(Outcome = c('N'), `1` = '-') %>%
select(Outcome, `1`, `2`, `3`) %>%
rbind(c('T', 'Always', '-', '-' )) %>%
arrange(`2`), align = 'lccc') %>%
kable_styling(full_width = F, position = 'left') %>%
add_header_above(c(" " = 1, "Recommended Dose" = 3))
| Outcome | 1 | 2 | 3 |
|---|---|---|---|
| T | Always |
|
|
| N |
|
1-30 | 31-56 |
Calculating the next pathway becomes more tricky depending on the outcome. It is somewhat similar to having a cohort of 2 patients. In both these cases the possible outcomes are:
As before the TT case is quite simple to solve as the weights/follow-up are set at 1. Similarly NT can be summarised in a similar way as above except when we run the CRM there will be an extra patient with a toxicity.
level <- c(1,1)
tox <- c(1,1)
followup <- c(56,56)
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, scheme = 'linear', followup = followup)
mod
## Today: Tue Aug 18 21:08:19 2020
## DATA SUMMARY (TITE-CRM)
## PID Level Toxicity f/u Weight Included
## 1 1 1 56 1 1
## 2 1 1 56 1 1
##
## Toxicity probability update (with 90 percent probability interval):
## Level Prior n total.wts total.tox Ptox LoLmt UpLmt
## 1 0.1 2 2 2 0.629 0.205 0.873
## 2 0.2 0 0 0 0.723 0.33 0.91
## 3 0.3 0 0 0 0.785 0.436 0.932
## Next recommended dose level: 1
## Recommendation is based on a target toxicity probability of 0.2
##
## Estimation details:
## Empiric dose-toxicity model: p = dose^{exp(beta)}
## dose = 0.1 0.2 0.3
## Normal prior on beta with mean 0 and variance 1.34
## Posterior mean of beta: -1.603
## Posterior variance of beta: 0.559
The reccommended dose is dose level 1.
level <- c(1,1)
tox <- c(1,0)
followupcombo <- cbind(rep(56, obswin), 1:56)
results <- data.frame('Observed' = 1:56, 'Rec' = rep(0,obswin))
for (i in 1:obswin) {
followup <- followupcombo[i,]
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, scheme = 'linear', followup = followup)
results$Rec[i] <- mod$mtd
}
kable(results %>% group_by(TD20 = Rec) %>%
summarise(n = n()), align = 'cc') %>%
kable_styling(full_width = F, position = 'left')
| TD20 | n |
|---|---|
| 1 | 56 |
The recommended dose is 1 no matter how much observed data there is for the patient with no toxicity.
Here there are 3136 variations of the NN outcome. The number of variations is \((observation \; period)^ {No. \;Patients}\). We could observe both patiens for 1 day each or both for the whole window and everything inbetween.
level <- c(1,1)
tox <- c(0,0)
combos <- 1:obswin
combos <- expand.grid(combos, combos)
pos <- cbind(rep(0,nrow(combos)))
results <- pos[, rep(1, each=length(tox)+1)]
for (i in 1:nrow(combos)) {
followup <- as.numeric(combos[i,])
weights <- followup / obswin
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, weights = weights)
for (j in 1:ncol(results)) {
results[,j][i] <- followup[j]
results[,ncol(results)][i] <- mod$mtd
}
}
results <- data.frame(results)
colnames(results) <- c('Patient1', 'Patient2', 'TD20')
results
Scrolling through the table you can see that certain combinations of follow up times lead to different reccomendations for the TD.
One thought I had was to look at the total follow up of both patients depending on what dose recommendation the TITE-CRM made.
kable(results %>% mutate(TotalFollow = Patient1+Patient2) %>%
group_by(TD20) %>%
summarise(n = n(), min = min(TotalFollow), max = max(TotalFollow)),
align = 'cccc') %>%
kable_styling(full_width = F, position = 'left')
| TD20 | n | min | max |
|---|---|---|---|
| 2 | 488 | 2 | 33 |
| 3 | 2648 | 31 | 112 |
One assumption used here is that both patients will have at least 1 day of follow-up. The table indicates that if the total follow-up time between both patients exceeds 33 the TITE-CRM will recommed dose level 3. Similarly, if total follow-up is less than 30 the model will always recommend dose level 2. However, there is a grey area, if the total follow-up is between 31 and 33 it could recommend either dose.
results %>%
ggplot(aes(x = Patient1, y = Patient2, fill = as.factor(TD20))) +
geom_tile() +
scale_fill_brewer(palette = 'Paired') +
theme_bw() +
geom_abline(intercept = 30, slope = -1, col = 'red',
linetype = 'dashed') +
geom_abline(intercept = 34, slope = -1, col = 'red',
linetype = 'dashed') +
theme(panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black")) +
labs(fill = 'TD20', x = 'Patient 1 follow-up',
y = 'Patient 2 follow-up')+
scale_x_continuous(breaks = seq(0, 60, by = 05), expand = c(0, 0))+
scale_y_continuous(breaks = seq(0, 60, by = 05), expand = c(0, 0))
I am not sure what is causing this. If the observation window were longer I would assume this becomes a singular straight line.
kable(data.frame(Outcomes = c('TT', 'NT', 'NN'),
`1` = c('Always', 'Always', '-'),
`2` = c('-', '-', '2-30'),
`3` = c('-', '-', '34-112'), check.names = FALSE),
align = 'lccc') %>%
kable_styling(full_width = F, position = 'left') %>%
add_header_above(c(" " = 1, "Recommended Dose" = 3))
| Outcomes | 1 | 2 | 3 |
|---|---|---|---|
| TT | Always |
|
|
| NT | Always |
|
|
| NN |
|
2-30 | 34-112 |
Possible outcomes:
These are just extensions of the case with two patients except an extra patient has a toxicity.
level <- c(1,1,1)
tox <- c(1,1,1)
followup <- c(56,56,56)
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, scheme = 'linear', followup = followup)
mod
## Today: Tue Aug 18 21:08:22 2020
## DATA SUMMARY (TITE-CRM)
## PID Level Toxicity f/u Weight Included
## 1 1 1 56 1 1
## 2 1 1 56 1 1
## 3 1 1 56 1 1
##
## Toxicity probability update (with 90 percent probability interval):
## Level Prior n total.wts total.tox Ptox LoLmt UpLmt
## 1 0.1 3 3 3 0.695 0.307 0.894
## 2 0.2 0 0 0 0.776 0.438 0.925
## 3 0.3 0 0 0 0.827 0.54 0.943
## Next recommended dose level: 1
## Recommendation is based on a target toxicity probability of 0.2
##
## Estimation details:
## Empiric dose-toxicity model: p = dose^{exp(beta)}
## dose = 0.1 0.2 0.3
## Normal prior on beta with mean 0 and variance 1.34
## Posterior mean of beta: -1.846
## Posterior variance of beta: 0.513
The reccommended dose is dose level 1.
level <- c(1,1,1)
tox <- c(0,1,1)
followupcombo <- cbind(1:56, rep(56, obswin), rep(56, obswin))
results <- data.frame('Observed' = 1:56, 'Rec' = rep(0,obswin))
for (i in 1:obswin) {
followup <- followupcombo[i,]
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, scheme = 'linear', followup = followup)
results$Rec[i] <- mod$mtd
}
kable(results %>% group_by(TD20 = Rec) %>%
summarise(n=n()), align = 'cc') %>%
kable_styling(full_width = F, position = 'left')
| TD20 | n |
|---|---|
| 1 | 56 |
Similar to before the recommended dose will always be 1 no matter how much data is observed for the patient without a toxicity.
level <- c(1,1,1)
tox <- c(1,0,0)
combos <- 1:obswin
combos <- expand.grid(combos, combos)
combos <- cbind(56, combos)
pos <- cbind(rep(0,nrow(combos)))
results <- pos[, rep(1, each=3)]
for (i in 1:nrow(combos)) {
followup <- as.numeric(combos[i,])
weights <- followup / obswin
mod <- titecrm(prior = prior, target = target, tox = tox, level = level,
obswin = obswin, weights = weights)
for (j in 1:ncol(results)) {
results[,j][i] <- followup[j]
results[,ncol(results)][i] <- mod$mtd
}
}
results <- data.frame(results)
colnames(results) <- c('Patient1', 'Patient2', 'TD20')
kable(results %>% group_by(TD20) %>%
summarise(n=n()), align = 'cc') %>%
kable_styling(full_width = F, position = 'left')
| TD20 | n |
|---|---|
| 1 | 3136 |
With one toxicity the model still won’t escalate even if two other patients have been fully observed without tox.
I ran these separately. Took about 1 hour for all iterations.
load('TITE_DTPs_3.RData')
results <- data.frame(results)
colnames(results) <- c('Patient1', 'Patient2', 'Patient3', 'TD20')
results
kable(results %>%
mutate(TotalFollow = Patient1+Patient2+Patient3) %>%
group_by(TD20) %>%
summarise(n = n(), min = min(TotalFollow), max = max(TotalFollow)),
align = 'cccc') %>%
kable_styling(full_width = F, position = 'left')
| TD20 | n | min | max |
|---|---|---|---|
| 2 | 5339 | 3 | 34 |
| 3 | 170277 | 31 | 168 |
These results can be interpreted similar to the ones before except now the total follow-up is for three patients. So, if the total follow-up is between 3 and 30 the model will definitely recommend dose level 2. If the total follow up is between 35 and 168 the model will definitely recommend dose level 3. If the total follow up is between 31 and 34 it could be either 2 or 3.
Interactive plot. Essentially a 3D version of the plot before. We could define two planes where everything above and below would be a certain dose. My linear algebra is a bit rusty so i’ll pursue this if you think its worth the time.
plot3d(x = results$Patient1, y = results$Patient2, z = results$Patient3,
col = as.factor(results$TD20), xlab = 'Patient 1 follow-up',
ylab = 'Patient 2 follow-up', zlab = 'Patient 3 follow-up')
You must enable Javascript to view this page properly.
kable(data.frame(Outcomes = c('TTT', 'NTT', 'NNT', 'NNN'),
`1` = c('Always', 'Always', 'Always', '-'),
`2` = c('-', '-', '-' ,'3-30'),
`3` = c('-', '-', '-', '35-168'), check.names = FALSE),
align = 'lccc') %>%
kable_styling(full_width = F, position = 'left') %>%
add_header_above(c(" " = 1, "Recommended Dose" = 3))
| Outcomes | 1 | 2 | 3 |
|---|---|---|---|
| TTT | Always |
|
|
| NTT | Always |
|
|
| NNT | Always |
|
|
| NNN |
|
3-30 | 35-168 |
ADePT is slightly different due to the way in which the follow-up period works. Each patient is observed for a minimum of 8 weeks post treatment which is assigned a weighting of 60%. So the DTP will be based on observed follow-up from 8 weeks till the end of the entire follow-up period (52 weeks). This is 308 days and as we are using cohorts of 3 there is about 29.5 million possible outcomes (this would take about 5-6 days to run). Due to the rules of ADePT we won’t be skipping untried doses. So for the first cohort there is only two options escalate to the dose above or de-escalate to the dose below.
sessionInfo()
## R version 3.6.0 (2019-04-26)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=English_United Kingdom.1252
## [2] LC_CTYPE=English_United Kingdom.1252
## [3] LC_MONETARY=English_United Kingdom.1252
## [4] LC_NUMERIC=C
## [5] LC_TIME=English_United Kingdom.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] rgl_0.100.54 knitr_1.25 rglwidget_0.2.1 car_3.0-9
## [5] carData_3.0-4 kableExtra_1.1.0 ggplot2_3.3.2 tidyr_1.0.2
## [9] dplyr_0.8.5 dtpcrm_0.1.1 dfcrm_0.2-2.1
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.4 assertthat_0.2.1
## [3] digest_0.6.25 mime_0.7
## [5] R6_2.4.1 cellranger_1.1.0
## [7] evaluate_0.14 highr_0.8
## [9] httr_1.4.1 pillar_1.4.3
## [11] rlang_0.4.5 curl_4.3
## [13] readxl_1.3.1 rstudioapi_0.10
## [15] data.table_1.12.2 miniUI_0.1.1.1
## [17] rmarkdown_1.15 webshot_0.5.2
## [19] readr_1.3.1 stringr_1.4.0
## [21] foreign_0.8-71 htmlwidgets_1.5.1
## [23] munsell_0.5.0 shiny_1.3.2
## [25] compiler_3.6.0 httpuv_1.5.1
## [27] xfun_0.9 pkgconfig_2.0.3
## [29] htmltools_0.3.6 tidyselect_1.0.0
## [31] tibble_2.1.3 rio_0.5.16
## [33] viridisLite_0.3.0 crayon_1.3.4
## [35] withr_2.1.2 later_0.8.0
## [37] grid_3.6.0 jsonlite_1.6
## [39] xtable_1.8-4 gtable_0.3.0
## [41] lifecycle_0.2.0 magrittr_1.5
## [43] scales_1.0.0 zip_2.0.4
## [45] stringi_1.4.6 promises_1.0.1
## [47] xml2_1.2.2 vctrs_0.2.4
## [49] openxlsx_4.1.5 RColorBrewer_1.1-2
## [51] tools_3.6.0 forcats_0.4.0
## [53] manipulateWidget_0.10.1 glue_1.3.2
## [55] purrr_0.3.3 hms_0.5.1
## [57] crosstalk_1.0.0 abind_1.4-5
## [59] yaml_2.2.0 colorspace_1.4-1
## [61] rvest_0.3.4 haven_2.1.1